unit cue;

interface

uses SysUtils, Classes, WideStringList;

type
  TCUEFileEntryClass = (ceBinary, ceMotorola, ceAIFF, ceWAVE, ceMP3);
  TCUETrackClass = (ctAudio, ctCDG);
  TCUETrackFlag = (ctfDCP, ctf4CH, ctfPRE, ctfSCMS);
  TCUETrackFlags = set of TCUETrackFlag;

  TCUEMSF = record
    Minute: word;
    Second,
    Frame: byte;
  end;

  PCUETrackIndex = ^TCUETrackIndex;
  TCUETrackIndex = record
    Index: byte;
    Start: TCUEMSF;
  end;

  TCUETrack = class(TObject)
  private
    FIndexes: TList;
    FIndex: integer;
    FPre: TCUEMSF;
    FPost: TCUEMSF;
    FISRC: ShortString;
    FFlags: TCUETrackFlags;
    FSongw,
    FPerf,
    FTitle: wideString;
    FType: TCUETrackClass;
    FLength: integer;
    function RGetIndex(index: byte): TCUETrackIndex;
    function RIndexCount: byte;
    procedure RSetIndex(index: byte; const Value: TCUETrackIndex);
    procedure SetFlags(const Value: TCUETrackFlags);
    procedure SetISRC(const Value: ShortString);
    procedure SetPerf(const Value: widestring);
    procedure SetPost(const Value: TCUEMSF);
    procedure SetPre(const Value: TCUEMSF);
    procedure SetSongw(const Value: widestring);
    procedure SetTitle(const Value: widestring);
    procedure SetType(const Value: TCUETrackClass);
    procedure SetIndex(const Value: integer);
    procedure SetLength(const Value: integer);
  public
    constructor Create;
    destructor Destroy; override;

    property Flags: TCUETrackFlags read FFlags write SetFlags;
    property ISRC: ShortString read FISRC write SetISRC;
    property Performer: widestring read FPerf write SetPerf;
    property Songwriter: widestring read FSongw write SetSongw;
    property Title: widestring read FTitle write SetTitle;
    property Pregap: TCUEMSF read FPre write SetPre;
    property Postgap: TCUEMSF read FPost write SetPost;
    property TrackType: TCUETrackClass read FType write SetType;
    property Index: integer read FIndex write SetIndex;
    property Length: integer read FLength write SetLength;

    function AddTrackIndex(Index: byte; Position: TCUEMSF): integer;
    procedure DeleteTrackIndex(Index: integer; ByListPos: boolean = true);
    property TrackIndexCount: byte read RIndexCount;
    property TrackIndex[index: byte]: TCUETrackIndex read RGetIndex write RSetIndex;
    function FindIndex(Index: byte): integer;

    function AsString: WideString;
  end;

  TCUEFileEntry = class(TObject)
  private
    FTracks: TList;
    FEClass: TCUEFileEntryClass;
    FFile: widestring;
    procedure SetEClass(const Value: TCUEFileEntryClass);
    procedure SetFile(const Value: WideString);
    function RGetTrk(index: integer): TCUETrack;
    procedure RSetTrk(index: integer; const Value: TCUETrack);
    procedure UpdateLengths;
  public
    constructor Create;
    destructor Destroy; override;

    property EntryClass: TCUEFileEntryClass read FEClass write SetEClass;
    property Filename: WideString read FFile write SetFile;

    function AddTrack: TCUETrack;
    procedure RemoveTrack(Index: integer);
    function TrackCount: integer;
    property Track[index: integer]: TCUETrack read RGetTrk write RSetTrk;

    function AsString: WideString;
  end;

  TCUESheet = class(TObject)
  private
    FObjects: TList;
    FCDText: WideString;
    FCat: WideString;
    FTitle: WideString;
    FSongw: WideString;
    FPerf: WideString;
    FDiscID: widestring;
    FGenre: widestring;
    FDate: widestring;
    procedure SetCat(const Value: WideString);
    procedure SetCDText(const Value: WideString);
    procedure SetPerf(const Value: WideString);
    procedure SetSongw(const Value: WideString);
    procedure SetTitle(const Value: WideString);
    function REntCount: integer;
    function RGetEntry(index: integer): TCUEFileEntry;
    procedure RSetEntry(index: integer; const Value: TCUEFileEntry);
    function RCompileCUE: WideString;
    procedure SetDate(const Value: widestring);
    procedure SetDiscID(const Value: widestring);
    procedure SetGenre(const Value: widestring);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Cleanup;
    procedure Save(Filename: WideString; Codepage: integer = 0);
    procedure Load(Filename: WideString);

    function AppendEntry(Filename: WideString; EntryClass: TCUEFileEntryClass = ceWAVE): TCUEFileEntry;
    procedure RemoveEntry(index: integer);
    property EntryCount: integer read REntCount;
    property Entry[index: integer]: TCUEFileEntry read RGetEntry write RSetEntry;

    property Catalog: WideString read FCat write SetCat;
    property CDTextFile: WideString read FCDText write SetCDText;
    property Performer: WideString read FPerf write SetPerf;
    property Songwriter: WideString read FSongw write SetSongw;
    property Title: WideString read FTitle write SetTitle;
    property DiscID: widestring read FDiscID write SetDiscID;
    property Genre: widestring read FGenre write SetGenre;
    property Date: widestring read FDate write SetDate;

    property AsString: WideString read RCompileCUE;
  end;

function MakeMSF(M,S,F: byte): TCUEMSF;

implementation

uses WideStrUtils;

function WideCharPos(const wc: WideChar; const ws: WideString; offset: integer = 1): integer;
var i: integer;
begin
  Result := 0;
  for i := offset to Length(ws) do
    if ws[i] = wc then begin
      Result := i;
      break;
    end;
end;

function WideCopy(const Src: WideString; const Start: integer; Count: integer = -1): WideString;
var i: integer;
begin
  Result := '';
  if Count = -1 then Count := Length(Src)-Start;
  for i := Start to Start+Count-1 do
    if i < Length(src)+1 then Result := Result+Src[i]
    else break;
end;

function StrToWideString(s: string): wideString;
begin
  if not IsUTF8String(s) then
    s := AnsiToUTF8(s);
  Result := UTF8Decode(s);
end;

function MSFToFrames(const MSF: TCUEMSF): integer;
begin
  Result := MSF.Frame+(MSF.Second*75)+(MSF.Minute*60*75);
end;

function MSFToStr(const MSF: TCUEMSF): ShortString;
begin
  Result := Format('%.2d:%.2d:%.2d', [MSF.Minute, MSF.Second, MSF.Frame]);
end;

function StrToMSF(const ws: WideString): TCUEMSF;
var m,s,f: WideString;
begin
  m := WideCopy(ws,1,2);
  s := WideCopy(ws,4,2);
  f := WideCopy(ws,7,2);
  Result.Minute := StrToInt(m);
  Result.Second := StrToInt(s);
  Result.Frame := StrToInt(f);
end;

function TrackClassToStr(const TrackClass: TCUETrackClass): WideString;
begin
  case TrackClass of
    ctAudio: Result := 'AUDIO';
    ctCDG: Result := 'CDG';
  end;
end;

function FlagsToStr(const Flags: TCUETrackFlags): WideString;
begin
  Result := '';
  if ctfDCP in Flags then Result := Result+'DCP ';
  if ctf4CH in Flags then Result := Result+'4CH ';
  if ctfPRE in Flags then Result := Result+'PRE ';
  if ctfSCMS in Flags then Result := Result+'SCMS ';
  if Result <> '' then Delete(result, Length(result), 1);
end;

function FileEntryClassToStr(const EClass: TCUEFileEntryClass): WideString;
begin
  case EClass of
    ceBinary: Result := 'BINARY';
    ceMotorola: Result := 'MOTOROLA';
    ceAIFF: Result := 'AIFF';
    ceWAVE: Result := 'WAVE';
    ceMP3: Result := 'MP3';
  end;
end;

function StrToFileEntryClass(const ws: WideString): TCUEFileEntryClass;
begin
  Result := ceBinary;
  if ws = 'BINARY' then Result := ceBinary;
  if ws = 'MOTOROLA' then Result := ceMotorola;
  if ws = 'AIFF' then Result := ceAIFF;
  if ws = 'WAVE' then Result := ceWAVE;
  if ws = 'MP3' then Result := ceMP3;
end;

function MakeMSF(M,S,F: byte): TCUEMSF;
begin
  Result.Minute := M;
  Result.Second := S;
  Result.Frame := F;
end;

{ TCUETrack }

function TCUETrack.AddTrackIndex(Index: byte; Position: TCUEMSF): integer;
var pss: PCUETrackIndex;
begin
  Result := -1;
//  if FindIndex(Index) > -1 then exit;

  New(pss);
  pss^.Index := Index;
  pss^.Start := Position;
  FIndexes.Add(pss);
end;

function TCUETrack.AsString: WideString;
var i: integer;
    pss: PCUETrackIndex;
begin
  // Compile TRACK section
  Result := WideFormat('  TRACK %.2d %s', [FIndex, TrackClassToStr(Self.FType)])+#13#10;
  if Self.FTitle <> '' then
    Result := Result+'    TITLE "'+FTitle+'"'#13#10;
  if Self.FPerf <> '' then
    Result := Result+'    PERFORMER "'+FPerf+'"'#13#10;
  if Self.FSongw <> '' then
    Result := Result+'    SONGWRITER "'+FSongw+'"'#13#10;
  if Self.FISRC <> '' then
    Result := Result+'    ISRC "'+FISRC+'"'#13#10;
  if Self.FFlags <> [] then
    Result := Result+'    FLAGS '+FlagsToStr(FFlags)+#13#10;
  if MSFToFrames(Self.FPre) > 0 then
    Result := Result+'    PREGAP "'+MSFToStr(FPre)+'"'#13#10;
  // writing indexes
  for i := 0 to FIndexes.Count-1 do begin
    pss := FIndexes[i];
    Result := Result+WideFormat('    INDEX %.2d %s'#13#10, [pss^.Index, MSFToStr(pss^.Start)]);
  end;
  if MSFToFrames(Self.FPost) > 0 then
    Result := Result+'    POSTGAP "'+MSFToStr(FPost)+'"'#13#10;
end;

constructor TCUETrack.Create;
begin
  FIndexes := TList.Create;
end;

procedure TCUETrack.DeleteTrackIndex(Index: integer; ByListPos: boolean);
var idx: integer;
begin
  if ByListPos then idx := index
  else idx := FindIndex(Index);

  if (idx >= 0) and (idx < FIndexes.Count) then begin
    Dispose(FIndexes[idx]);
    FIndexes.Delete(idx);
  end;
end;

destructor TCUETrack.Destroy;
var i: integer;
begin
  for i := 0 to FIndexes.Count-1 do
    FIndexes[i] := nil;
  FreeAndNil(FIndexes);
  inherited;
end;

function TCUETrack.FindIndex(Index: byte): integer;
var i: integer;
begin
  Result := -1;
  for i := 0 to FIndexes.Count-1 do
    if PCUETrackIndex(FIndexes[i])^.Index = Index then begin
      Result := i;
      break;
    end;
end;

function TCUETrack.RGetIndex(index: byte): TCUETrackIndex;
begin
  Result := PCUETrackIndex(FIndexes[index])^;
end;

function TCUETrack.RIndexCount: byte;
begin
  Result := FIndexes.Count;
end;

procedure TCUETrack.RSetIndex(index: byte; const Value: TCUETrackIndex);
begin
  PCUETrackIndex(FIndexes[index])^ := Value;
end;

procedure TCUETrack.SetFlags(const Value: TCUETrackFlags);
begin
  FFlags := Value;
end;

procedure TCUETrack.SetIndex(const Value: integer);
begin
  FIndex := Value;
end;

procedure TCUETrack.SetISRC(const Value: ShortString);
begin
  FISRC := Value;
end;

procedure TCUETrack.SetLength(const Value: integer);
begin
  FLength := Value;
end;

procedure TCUETrack.SetPerf(const Value: widestring);
begin
  FPerf := Value;
end;

procedure TCUETrack.SetPost(const Value: TCUEMSF);
begin
  FPost := Value;
end;

procedure TCUETrack.SetPre(const Value: TCUEMSF);
begin
  FPre := Value;
end;

procedure TCUETrack.SetSongw(const Value: widestring);
begin
  FSongw := Value;
end;

procedure TCUETrack.SetTitle(const Value: widestring);
begin
  FTitle := Value;
end;

procedure TCUETrack.SetType(const Value: TCUETrackClass);
begin
  FType := Value;
end;

{ TCUESheet }

function TCUESheet.AppendEntry(Filename: WideString;
  EntryClass: TCUEFileEntryClass): TCUEFileEntry;
var pss: TCUEFileEntry;
begin
  pss := TCUEFileEntry.Create;
  pss.EntryClass := EntryClass;
  pss.Filename := Filename;
  Self.FObjects.Add(pss);
  Result := pss;
end;

procedure TCUESheet.Cleanup;
begin
  FCDText := '';
  FCat := '';
  FTitle := '';
  FSongw := '';
  FPerf := '';
  while FObjects.Count > 0 do begin
    TCUEFileEntry(FObjects[0]).Free;
    FObjects.Delete(0);
  end;
end;

constructor TCUESheet.Create;
begin
  FObjects := TList.Create;
end;

destructor TCUESheet.Destroy;
begin
  Cleanup;
  FreeAndNil(FObjects);
  inherited;
end;

function GetKeyword(ws: WideString): WideString;
begin
  ws := Trim(ws);
  Result := UpperCase(Copy(ws,1,Pos(' ',ws)-1));
end;

function StrBegins(ws,seek: wideString): boolean;
begin
  Result := WideSameText(copy(ws,1,Length(seek)), Seek);
end;

function GetKeyValue(ws: WideString): WideString;
begin
  ws := Trim(ws);
  Result := Copy(ws,Pos(' ',ws)+1,Length(ws));
  if Result[1] = WideChar('"') then
    Delete(Result,1,1);
  if Result[Length(Result)] = WideChar('"') then
    Delete(Result,Length(Result),1);
end;

function GetFile(ws: WideString; out FileClass: WideString): WideString;
var i: integer;
begin
  Fileclass := '';
  Result := WideCopy(ws,Pos(' ',ws)+1,Length(ws));

  if Result[1] = WideChar('"') then
    Delete(Result,1,1);

  if WideCharPos('"', Result) > 0 then
    i := WideCharPos('"', Result)
  else i := WideCharPos(' ', Result);

  FileClass := Trim(WideCopy(Result,i+1,16));
  Result := WideCopy(Result, 1, i-1);
end;

procedure GetIndex(ws: WideString; out Idx: byte; out STime: WideString);
var i: integer;
begin
  ws := Trim(ws); Idx := 0; STime := '';
  ws := WideCopy(ws,Pos(' ',ws)+1,Length(ws)); // Cut off INDEX keyword
  i := WideCharPos(' ',ws);
  if i > 0 then begin
    Idx := StrToInt(WideCopy(ws,1,i-1));
    i := WideCharPos(' ',ws,i);
    if i > 0 then begin
      STime := WideCopy(ws, i+1, 16);
    end;
  end;
end;

procedure ParseTrack(ws: widestring; out Idx: byte; out At: widestring);
var i: integer;
begin
  ws := Trim(ws); Idx := 0; at := '';
  ws := WideCopy(ws,Pos(' ',ws)+1,Length(ws)); // Cut off TRACK keyword

  i := WideCharPos(' ',ws);
  if i > 0 then begin
    Idx := StrToInt(WideCopy(ws,1,i-1));
    i := WideCharPos(' ',ws,i);
    if i > 0 then begin
      at := WideCopy(ws, i+1, 16);
    end;
  end;
end;

procedure TCUESheet.Load(Filename: WideString);
var ws: TWideStringList;
    i: integer;
    cfe: TCUEFileEntry;
    ctt: TCUETrack;
    wsf: WideString;
    aIndex: byte;
begin
  Self.Cleanup;

  ws := TWideStringList.Create;
  ws.Load(Filename);

  cfe := nil; ctt := nil;
  for i := 0 to ws.Count-1 do begin
    if not Assigned(cfe) and not Assigned(ctt) then begin
      // Generic info
      if GetKeyWord(ws[i]) = 'CATALOG' then Self.Catalog := GetKeyValue(ws[i]);
      if GetKeyWord(ws[i]) = 'CDTEXTFILE' then Self.CDTextFile := GetKeyValue(ws[i]);
      if GetKeyWord(ws[i]) = 'PERFORMER' then Self.Performer := GetKeyValue(ws[i]);
      if GetKeyWord(ws[i]) = 'TITLE' then Self.Title := GetKeyValue(ws[i]);
      if GetKeyWord(ws[i]) = 'SONGWRITER' then Self.Songwriter := GetKeyValue(ws[i]);
      if StrBegins(ws[i], 'REM DISCID') then Self.DiscID := trim(copy(ws[i],Length('REM DISCID')+1, 32));
      if StrBegins(ws[i], 'REM GENRE') then Self.Genre := trim(copy(ws[i],Length('REM GENRE')+1, 32));
      if StrBegins(ws[i], 'REM DATE') then Self.Date := trim(copy(ws[i],Length('REM DATE')+1, 64));
    end;

    if GetKeyWord(ws[i]) = 'FILE' then begin
      // Starting FILE entry
      cfe := Self.AppendEntry(GetFile(ws[i],wsf), ceBinary);
      cfe.EntryClass := StrToFileEntryClass(wsf);
    end;

    if Assigned(cfe) then begin
      wsf := GetKeyWord(ws[i]);
      if wsf = 'TRACK' then begin
        ctt := cfe.AddTrack;
        ctt.TrackType := ctAudio;
        ParseTrack(ws[i], aIndex, wsf);
        ctt.Index := aIndex;
      end;
      // Track?
      if Assigned(ctt) then begin
        if GetKeyword(ws[i]) = 'TITLE' then ctt.Title := GetKeyValue(ws[i]);
        if GetKeyword(ws[i]) = 'PERFORMER' then ctt.Performer := GetKeyValue(ws[i]);
        if GetKeyword(ws[i]) = 'SONGWRITER' then ctt.Songwriter := GetKeyValue(ws[i]);
        if GetKeyword(ws[i]) = 'ISRC' then ctt.ISRC := GetKeyValue(ws[i]);
        //if GetKeyword(ws[i]) = 'FLAGS' then ctt.Title := GetKeyValue(ws[i]);
        if GetKeyword(ws[i]) = 'PREGAP' then ctt.Pregap := StrToMSF(GetKeyValue(ws[i]));
        if GetKeyword(ws[i]) = 'POSTGAP' then ctt.Postgap := StrToMSF(GetKeyValue(ws[i]));
        if GetKeyword(ws[i]) = 'INDEX' then begin
          GetIndex(ws[i], aIndex, wsf);
          ctt.AddTrackIndex(aIndex, StrToMSF(wsf));
        end;
      end;
    end;
  end;
  ws.Free;

  // Update tracklengths
  for i := 0 to Self.FObjects.Count-1 do begin
    TCUEFileEntry(FObjects[i]).UpdateLengths;
  end;
end;

function TCUESheet.RCompileCUE: WideString;
var i: integer;
begin
  Result := '';
  if FDISCId <> '' then
    Result := Result+WideFormat('REM DISCID %s'#13#10, [FDISCId]);
  if FDate <> '' then
    Result := Result+WideFormat('REM DATE %s'#13#10, [FDate]);
  if FGenre <> '' then
    Result := Result+WideFormat('REM GENRE %s'#13#10, [FGenre]);
    
  if FCDText <> '' then
    Result := Result+WideFormat('CDTEXTFILE "%s"'#13#10, [FCDText]);
  if FCat <> '' then
    Result := Result+WideFormat('CATEGORY "%s"'#13#10, [FCat]);
  if FTitle <> '' then
    Result := Result+WideFormat('TITLE "%s"'#13#10, [FTitle]);
  if FSongw <> '' then
    Result := Result+WideFormat('SONGWRITER "%s"'#13#10, [FSongw]);
  if FPerf <> '' then
    Result := Result+WideFormat('PERFORMER "%s"'#13#10, [FPerf]);

  // writing file entries
  for i := 0 to FObjects.Count-1 do
    Result := Result + TCUEFileEntry(FObjects[i]).AsString;
end;

procedure TCUESheet.RemoveEntry(index: integer);
begin
  TCUEFileEntry(FObjects[index]).Free;
  FObjects.Delete(index);
end;

function TCUESheet.REntCount: integer;
begin
  Result := Self.FObjects.Count;
end;

function TCUESheet.RGetEntry(index: integer): TCUEFileEntry;
begin
  Result := TCUEFileEntry(FObjects[index]);
end;

procedure TCUESheet.RSetEntry(index: integer; const Value: TCUEFileEntry);
begin
  FObjects[index] := Value;
end;

procedure TCUESheet.Save(Filename: WideString; Codepage: integer);
var ws: TWideStringList;
begin
  ws := TWideStringList.Create;
  ws.Text := Self.AsString;

  if Codepage = 0 then
    // Save as ASCII
    ws.Save(Filename, cpASCII)
  else
    // Save as unicode
    ws.Save(Filename, cpUTF8);
    
  ws.Free;
end;

procedure TCUESheet.SetCat(const Value: WideString);
begin
  FCat := Value;
end;

procedure TCUESheet.SetCDText(const Value: WideString);
begin
  FCDText := Value;
end;

procedure TCUESheet.SetDate(const Value: widestring);
begin
  FDate := Value;
end;

procedure TCUESheet.SetDiscID(const Value: widestring);
begin
  FDiscID := Value;
end;

procedure TCUESheet.SetGenre(const Value: widestring);
begin
  FGenre := Value;
end;

procedure TCUESheet.SetPerf(const Value: WideString);
begin
  FPerf := Value;
end;

procedure TCUESheet.SetSongw(const Value: WideString);
begin
  FSongw := Value;
end;

procedure TCUESheet.SetTitle(const Value: WideString);
begin
  FTitle := Value;
end;

{ TCUEFileEntry }

function TCUEFileEntry.AddTrack: TCUETrack;
begin
  Result := TCUETrack.Create;
  FTracks.Add(Result);
end;

function TCUEFileEntry.AsString: WideString;
var i: integer;
begin
  Result := WideFormat('FILE "%s" %s'#13#10,[Self.FFile, FileEntryClassToStr(Self.FEClass)]);
  for i := 0 to FTracks.Count-1 do
    Result := Result+TCUETrack(FTracks[i]).AsString;
end;

constructor TCUEFileEntry.Create;
begin
  FTracks := TList.Create;
end;

destructor TCUEFileEntry.Destroy;
begin
  while FTracks.Count > 0 do begin
    TCUETrack(FTracks[0]).Free;
    FTracks.Delete(0);
  end;
  FTracks.Free;
  inherited;
end;

procedure TCUEFileEntry.RemoveTrack(Index: integer);
begin
  TCUETrack(FTracks[index]).Free;
  FTracks.Delete(index);
end;

function TCUEFileEntry.RGetTrk(index: integer): TCUETrack;
begin
  Result := TCUETrack(FTracks[index]);
end;

procedure TCUEFileEntry.RSetTrk(index: integer; const Value: TCUETrack);
begin
  FTracks[index] := Value;
end;

procedure TCUEFileEntry.SetEClass(const Value: TCUEFileEntryClass);
begin
  FEClass := Value;
end;

procedure TCUEFileEntry.SetFile(const Value: WideString);
begin
  FFile := Value;
end;

function TCUEFileEntry.TrackCount: integer;
begin
  Result := FTracks.Count;
end;

procedure TCUEFileEntry.UpdateLengths;
var i,c: integer;
    ct,ct1: TCUETrack;
begin
  c := 0;
  for i := 0 to FTracks.Count-2 do begin
    ct := FTracks[i];
    if i < FTracks.Count-1 then ct1 := FTracks[i+1] else ct1 := nil;

    if ct1 <> nil then
      ct.Length := MSFToFrames(ct1.TrackIndex[0].Start)-MSFToFrames(ct.TrackIndex[0].Start)
    else ct.Length := -1;
  end;
end;

end.